-- $Id: xpa-net-sck.adb,v 1.6 2006-01-01 05:24:05 bacon Exp $


with ada.unchecked_deallocation;

package body xpa.net.sck is

	procedure free is new ada.unchecked_deallocation (sck_type, sck_access);

	procedure open (sck: in out sck_access;
		family: in family_type; mode: in mode_type) is
	begin
		if sck = null then
			sck := new sck_type;
			sck.dynamic := true;
		end if;

		gnat.sockets.create_socket (sck.handle, family, mode);

		-- if an exception occurs after create_socket, close_socket
		-- must be called somewhere in the exception handler.

	exception
		when others =>
			if sck.dynamic = true then
				free (sck);
			end if;
			raise;
	end open;

	procedure close (sck: in out sck_access) is
	begin
		gnat.sockets.close_socket (sck.handle);
		if sck.dynamic = true then
			free (sck);
		end if;
	end close;

	procedure set_connect_timeout (
		sck: in out sck_access; timeout: in duration) is
	begin
		sck.connect_timeout := timeout;	
	end set_connect_timeout;

	procedure set_accept_timeout (
		sck: in out sck_access; timeout: in duration) is
	begin
		sck.accept_timeout := timeout;	
	end set_accept_timeout;

	procedure set_receive_timeout (
		sck: in out sck_access; timeout: in duration) is
	begin
		sck.receive_timeout := timeout;	
	end set_receive_timeout;

	procedure set_send_timeout (
		sck: in out sck_access; timeout: in duration) is
	begin
		sck.send_timeout := timeout;	
	end set_send_timeout;
		
	procedure bind (sck: in out sck_access;
		server: in out addr_type) is
	begin
		gnat.sockets.bind_socket (sck.handle, server);
	end bind;

	procedure connect (sck: in out sck_access;
		server: in out addr_type) is
	begin
		gnat.sockets.connect_socket (sck.handle, server);
	end connect;

	procedure listen (sck: in out sck_access; length: in positive := 15) is
	begin
		gnat.sockets.listen_socket (sck.handle, length);
	end listen;

	procedure receive (sck: in out sck_access;
		item: out ada.streams.stream_element_array; 
		last: out ada.streams.stream_element_offset) is

		selector: gnat.sockets.selector_type;
		rset: gnat.sockets.socket_set_type;
		wset: gnat.sockets.socket_set_type;
		status: gnat.sockets.selector_status;
	begin
		if sck.receive_timeout >= 0.0 then
			gnat.sockets.create_selector (selector);

-- TODO: error handling...
			gnat.sockets.empty (rset);
			gnat.sockets.set (rset, sck.handle);
			gnat.sockets.check_selector (selector, 
				rset, wset, status, sck.receive_timeout);
			gnat.sockets.close_selector (selector);
		end if;

		gnat.sockets.receive_socket (sck.handle, item, last);
	end receive;

	-- TODO receive for recvfrom.

	procedure send (sck: in out sck_access;
		item: in ada.streams.stream_element_array; 
		last: out ada.streams.stream_element_offset) is
	begin
		--gnat.sockets.send_socket (sck.handle, item, last);
		null;
	end send;

	-- TODO send for sendto.

end xpa.net.sck;
